home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / input.arc / MHSTRIN.SUB < prev   
Encoding:
Text File  |  1987-09-26  |  8.5 KB  |  293 lines
  1. '  Mh.String.Input
  2. '  Copyright 1987 MicroHelp, Inc. - All Rights Reserved
  3.  
  4. '  Requires MHDEF.INC for declaring constants
  5.  
  6. '  CALL Mh.String.Input (Mh.Response$,Mh.Input.Mask$,Mh.Current.Pos%,_
  7. '       Mh.Cursor.Normal.Start%,Mh.Cursor.Normal.End%,_
  8. '       Mh.Cursor.Insert.Start%,Mh.Cursor.Insert.End%)
  9.  
  10. '-------------------------------------------------------------------------
  11. '  Description - Edited string input according to the "masks" provided.
  12. '                Maximum length of string is determined by length of
  13. '                  Mh.Input.Mask$. If a character in the mask is not
  14. '                  a valid one, ANY character will be accepted for input.
  15.  
  16. '  On entry    - Set your colors and Locate to cursor position for input.
  17. '                Note that all numbers are INTEGERS. Use Mh.Current.Pos% to
  18. '                adjust actual starting point of edit.
  19.  
  20. '                Mh.Response$=String that the user can edit
  21.  
  22. '                Mh.Input.Mask$ - one character per input character allowed
  23. '                                 = Constant - for display only - no editing
  24. '                               ? = Anything allowed
  25. '                               # = 0-9 minus and space
  26. '                               9 = 0-9 only
  27. '                               @ = 0-9 plus space
  28. '                               A = Alpha (A-Z only) - convert to uppercase
  29. '                               a = Alpha (A-Z only) - convert to lowercase
  30. '                               B = Alpha plus space - convert to uppercase
  31. '                               b = Alpha plus space - convert to lowercase
  32.  
  33. '                    Note that if an invalid mask character is encountered,
  34. '                    it will be treated as '?', where ANYTHING is allowed
  35.  
  36. '                Mh.Current.Pos%=Position within string at which to start editing
  37.  
  38. '                Mh.Cursor.Normal.Start% = Start scan line
  39. '                Mh.Cursor.Normal.End%   = Cursor end line
  40. '                Mh.Cursor.Insert.Start% = Start scan line
  41. '                Mh.Cursor.Insert.End%   = End scan line
  42.  
  43. '  On exit -     Mh.Response$ contains edited input
  44. '                Mh.Terminator$(0) contains last keypress
  45. '         Mh.Current.Pos%=Last position at which a key was pressed
  46. '-------------------------------------------------------------------------
  47. SUB Mh.String.Input (Mh.Response$, Mh.Input.Mask$, Mh.Current.Pos%, Mh.Cursor.Normal.Start%, Mh.Cursor.Normal.End%, Mh.Cursor.Insert.Start%, Mh.Cursor.Insert.End%) STATIC
  48.  
  49.     DEFINT A-Z
  50.  
  51.     REM $INCLUDE: 'MhDef.Inc'
  52.     
  53.     IF Mh.Input.Mask$ = "" GOTO Final.exit  ' too short
  54.     
  55.     Vertical = CSRLIN               ' Find out where we are
  56.     Horizontal = POS(0)
  57.     
  58.     Work.String$ = Mh.Response$     ' Pad work string if necessary
  59.  
  60.     IF LEN(Mh.Input.Mask$) > LEN(Work.String$) THEN ' fill out if too short
  61.       Work.String$ = Work.String$ + STRING$(LEN(Mh.Input.Mask$) - LEN(Work.String$), Mh.Fill.Character%)
  62.     END IF
  63.  
  64.     IF LEN(Mh.Input.Mask$) < LEN(Work.String$) THEN ' if response too long
  65.       Mh.Input.Mask$ = Mh.Input.Mask$ + STRING$(LEN(Work.String$) - LEN(Mh.Input.Mask$), "?")
  66.     END IF
  67.  
  68.     Max.Pos = LEN(Work.String$)     ' Highest value that Mh.Current.Pos% can be
  69.  
  70.     If Mh.Current.Pos%<1 or Mh.Current.Pos%>Max.Pos Then
  71.       Mh.Current.Pos%=1
  72.       
  73.     End if  
  74.  
  75. Show.String:                            ' Display the string   
  76.  
  77.     LOCATE Vertical, Horizontal
  78.     PRINT Work.String$;
  79.  
  80. Position.Cursor:
  81.  
  82.     IF Insert.State THEN
  83.       LOCATE Vertical, Horizontal + Mh.Current.Pos%-1, 1, Mh.Cursor.Insert.Start%, Mh.Cursor.Insert.End%
  84.     ELSE
  85.       LOCATE Vertical, Horizontal + Mh.Current.Pos%-1, 1, Mh.Cursor.Normal.Start%, Mh.Cursor.Normal.End%
  86.     END IF
  87.  
  88. Fetch.key:
  89.  
  90.     A$ = INKEY$
  91.     IF A$ = "" GOTO Fetch.key
  92.  
  93.     LOCATE , , 0                    ' turn off cursor
  94.     
  95.     Hit = 0                         ' indicates found terminator character
  96.     FOR N = 1 TO Mh.Terminators
  97.       IF A$ = Mh.Terminator$(N) THEN
  98.          Hit = N
  99.          N = Mh.Terminators
  100.       END IF
  101.     NEXT
  102.     IF Hit GOTO Finish.up.input     ' if we found a terminator key
  103.  
  104.     IF LEN(A$) = 1 GOTO Ascii.Character
  105.     
  106.     A = ASC(MID$(A$, 2))                    ' get scan code
  107.     IF A = 75 GOTO Left.Arrow
  108.     IF A = 77 GOTO Right.Arrow
  109.     IF A = 71 GOTO Home
  110.     IF A = 79 GOTO End.key
  111.     IF A = 82 GOTO Toggle.Insert
  112.     IF A = 83 GOTO Delete.key
  113.     IF A = 116 GOTO Ctrl.Right
  114.     IF A = 115 GOTO Ctrl.Left
  115.     
  116. Bad.Key.Pressed:
  117.  
  118.     CALL Mh.Speaker                 ' Bad key pressed
  119.     GOTO Position.Cursor
  120.  
  121. Left.Arrow:
  122.  
  123.     Mh.Current.Pos% = Mh.Current.Pos% - 1
  124.     GOTO Check.cursor
  125.  
  126. Right.Arrow:
  127.  
  128.     Mh.Current.Pos% = Mh.Current.Pos% + 1
  129.     GOTO Check.cursor
  130.  
  131. Home:
  132.  
  133.     Mh.Current.Pos% = 1
  134.     GOTO Position.Cursor
  135.     
  136. End.key:
  137.  
  138.     Mh.Current.Pos% = Max.Pos
  139.     
  140. Redo.End.Key:           ' find last non space/fill character
  141.  
  142.     A = ASC(MID$(Work.String$, Mh.Current.Pos%))
  143.     IF A <> 32 AND A <> Mh.Fill.Character GOTO Fudge.end.key
  144.     IF Mh.Current.Pos% = 1 GOTO Position.Cursor
  145.     Mh.Current.Pos% = Mh.Current.Pos% - 1
  146.     GOTO Redo.End.Key
  147.     
  148. Toggle.Insert:
  149.  
  150.     Insert.State = Insert.State XOR 1    ' toggle it
  151.     GOTO Position.Cursor
  152.  
  153. Delete.key:
  154.  
  155.     IF Mh.Current.Pos% = Max.Pos THEN
  156.       MID$ (Work.String$, Mh.Current.Pos%, 1) = CHR$(Mh.Fill.Character)
  157.     ELSE
  158.       Work.String$ = LEFT$(Work.String$, Mh.Current.Pos%-1) + MID$(Work.String$, Mh.Current.Pos% + 1) + CHR$(Mh.Fill.Character)
  159.     END IF
  160.     GOTO Show.String
  161.  
  162. Ctrl.Right:
  163.  
  164.     Ctrl.Factor = 1
  165.     GOTO Redo.Ctrl.key
  166.     
  167. Ctrl.Left:
  168.  
  169.     Ctrl.Factor = -1
  170.     
  171. Redo.Ctrl.key:
  172.     
  173.     IF (Mh.Current.Pos% = 1 AND Ctrl.Factor = -1) OR (Mh.Current.Pos% = Max.Pos AND Ctrl.Factor = 1) GOTO Position.Cursor
  174.        
  175.     Mh.Current.Pos% = Mh.Current.Pos% + Ctrl.Factor
  176.     A = ASC(MID$(Work.String$, Mh.Current.Pos%))
  177.     A = INSTR(Word.separator$, CHR$(A))
  178.     IF A = 0 GOTO Redo.Ctrl.key
  179.     Mh.Current.Pos% = Mh.Current.Pos% + Ctrl.Factor ' one more so go past separator
  180.     GOTO Position.Cursor
  181.     
  182. Backspace:
  183.  
  184.     IF Mh.Current.Pos% = 1 THEN         ' No backspace when at first character
  185.       CALL Mh.Speaker
  186.       GOTO Position.Cursor
  187.     ELSE
  188.       Mh.Current.Pos% = Mh.Current.Pos% - 1
  189.       GOTO Delete.key               ' same logic as backspace
  190.     END IF
  191.                     
  192. Ascii.Character:
  193.     
  194.     IF ASC(A$) = 8 GOTO Backspace
  195.     
  196.     W$ = MID$(Mh.Input.Mask$, Mh.Current.Pos%, 1)' mask character
  197.  
  198.     ON INSTR("?#9@AaBb", W$) GOTO Character.ok, Num.minus.space, Num.only, Num.space, Alpha.caps.only, Alpha.lower.only, Alpha.caps.space, Alpha.lower.space
  199.     
  200.     GOTO Character.ok               ' if mask character invalid, anything goes
  201.     
  202. Num.minus.space:
  203.  
  204.     IF A$ = "-" GOTO Character.ok
  205.     
  206. Num.space:
  207.  
  208.     IF A$ = " " GOTO Character.ok
  209.     
  210. Num.only:
  211.     
  212.     IF INSTR("0123456789", A$) GOTO Character.ok
  213.     GOTO Bad.Key.Pressed
  214.  
  215. Alpha.caps.space:
  216.  
  217.     IF A$ = " " GOTO Character.ok
  218.         
  219. Alpha.caps.only:
  220.  
  221.     A$ = CHR$(ASC(A$) AND 223)      ' Turn off lower case bit
  222.     IF A$ >= "A" AND A$ <= "Z" GOTO Character.ok
  223.     GOTO Bad.Key.Pressed
  224.  
  225. Alpha.lower.space:
  226.  
  227.     IF A$ = " " GOTO Character.ok
  228.  
  229. Alpha.lower.only:
  230.  
  231.     A$ = CHR$(ASC(A$) OR 32)        ' Turn on lower case bit
  232.     IF A$ >= "a" AND A$ <= "z" GOTO Character.ok
  233.     GOTO Bad.Key.Pressed
  234.  
  235. Character.ok:
  236.  
  237.     IF Mh.Current.Pos% = Max.Pos OR Insert.State = False THEN
  238.       MID$ (Work.String$, Mh.Current.Pos%) = A$
  239.     ELSE
  240.       Work.String$ = LEFT$(Work.String$, Mh.Current.Pos%-1) + A$ + MID$(Work.String$, Mh.Current.Pos%)
  241.       Work.String$ = LEFT$(Work.String$, LEN(Work.String$) - 1)
  242.       '  we have to strip one character because we added one
  243.     END IF
  244.  
  245.     IF Mh.Current.Pos% = Max.Pos AND Mh.Auto.Terminate = True GOTO Finish.up.input
  246.  
  247. Fudge.end.key:
  248.  
  249.     IF Mh.Current.Pos% <> Max.Pos THEN Mh.Current.Pos% = Mh.Current.Pos% + 1
  250.     GOTO Show.String
  251.  
  252. Check.cursor:
  253.  
  254.     IF Mh.Current.Pos% > Max.Pos THEN
  255.       Mh.Current.Pos% = Max.Pos
  256.       CALL Mh.Speaker
  257.     END IF
  258.     
  259.     IF Mh.Current.Pos% < 1 THEN
  260.       Mh.Current.Pos% = 1
  261.       CALL Mh.Speaker
  262.     END IF
  263.     GOTO Show.String
  264.  
  265. Finish.up.input:                        ' set variables and return
  266.  
  267.     LOCATE Vertical, Horizontal
  268.     PRINT Work.String$;
  269.     
  270.     Hit = LEN(Work.String$)         ' new length of string
  271.     
  272.     FOR N = Hit TO 1 STEP -1        ' strip from right
  273.       IF ASC(MID$(Work.String$, N)) <> Mh.Fill.Character% AND ASC(MID$(Work.String$, N)) <> 32 THEN
  274.         Hit = N
  275.         N = 1
  276.       END IF
  277.     NEXT
  278.     
  279.     Work.String$ = LEFT$(Work.String$, Hit)
  280.            
  281.     FOR N = 1 TO LEN(Work.String$)  ' replace fill character with spaces
  282.       IF ASC(MID$(Work.String$, N)) = Mh.Fill.Character% THEN
  283.         MID$ (Work.String$, N, 1) = CHR$(32)
  284.       END IF
  285.     NEXT
  286.       
  287. Final.exit:
  288.  
  289.     Mh.Response$ = Work.String$
  290.     Mh.Terminator$(0) = A$          ' set last key entered
  291.     
  292. END SUB
  293.